home *** CD-ROM | disk | FTP | other *** search
/ Trading on the Edge / Trading On The Edge - CD-ROM Toolkit (Wayzata Technology)(2031)(1994).bin / pc / mac_file / vendor_d / ga_softw / ooga / classes.lis < prev    next >
Lisp/Scheme  |  1991-02-03  |  25KB  |  856 lines
  1. ;;; -*- Mode:Lisp; Package:OOGA; Base:10; Syntax:COMMON-LISP -*-
  2. #||
  3.             RESTRICTED RIGHTS LEGEND
  4.                     
  5.  Use, duplication, or disclosure by the Government is subject to
  6.  restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
  7.  Technical Data and Computer Software Clause at 52.227-7013 of the DOD
  8.  FAR Supplement.
  9.                     
  10.                 TSP (The Software Partnership)
  11.                 P.O. Box 991
  12.                 Melrose, MA 02176
  13.                     
  14.       Copyright 1990 by Lawrence Davis and Daniel Cerys, all rights reserved.
  15. ||#
  16.  
  17. (in-package :ooga)
  18.  
  19.  
  20. ;************************************************************
  21. ;************************************************************
  22.  
  23. ;     BASIC GENETIC ALGORITHM
  24.  
  25. ;************************************************************
  26. ;************************************************************
  27.  
  28.  
  29. (defvar *GA* nil "The current genetic algorithm")
  30.  
  31.  
  32. ;;; The Basic Genetic Algorithm Contains three modules that 
  33. ;;; support most of the action.
  34.  
  35. (defclass BASIC-GENETIC-ALGORITHM
  36.       ()
  37.   ((EVALUATION-MODULE :initarg :evaluation-module
  38.               :initform (make-instance 'basic-evaluation-module)
  39.               :accessor evaluation-module)
  40.    (POPULATION-MODULE :initarg :population-module
  41.               :initform (make-instance 'basic-population-module)
  42.               :accessor population-module)
  43.    (REPRODUCTION-MODULE :initarg :reproduction-module
  44.             :initform (make-instance 'basic-reproduction-module)
  45.             :accessor reproduction-module)
  46.    ))
  47.  
  48.  
  49.  
  50.  
  51. ;************************************************************
  52. ;************************************************************
  53.  
  54. ;     BASIC EVALUATION MODULE
  55.  
  56. ;************************************************************
  57. ;************************************************************
  58.  
  59.  
  60. ;;; The Evaluation Module has a pointer to its GA and an evaluator.
  61.  
  62. (defclass BASIC-EVALUATION-MODULE
  63.       ()
  64.   ((GA :initarg :ga :initform nil :accessor ga)
  65.    (EVALUATOR :initarg :evaluator
  66.           :initform nil
  67.           :accessor evaluator)
  68.    ))
  69.  
  70.  
  71. ;;; The evaluator has a pointer to its module.
  72.  
  73. (defclass EVALUATOR
  74.       ()
  75.      ((EVALUATION-MODULE :initarg :evaluation-module
  76.              :initform nil :accessor evaluation-module)
  77.       ))
  78.  
  79.  
  80. ;************************************************************
  81. ;************************************************************
  82.  
  83. ;     BASIC POPULATION MODULE
  84.  
  85. ;************************************************************
  86. ;************************************************************
  87.  
  88. ;;; The population module has pointers to a number of techniques and its GA.
  89. ;;; It also maintains the fitness list (list of fitnesses of population members);
  90. ;;; the population-size parameter, the desired-trials parameter, the current index
  91. ;;; that notes the number of individuals evaluated at the current point in a run;
  92. ;;; and a flag that can be set to stop a run.
  93.  
  94. ;;; All the techniques below have pointers to their modules.
  95.  
  96. (defclass BASIC-POPULATION-MODULE
  97.       (periodic-state-display
  98.         performance-statistics-collection
  99.         doubly-linked-list)
  100.   ((GA :initarg :ga :initform nil :accessor ga)
  101.    (FITNESS-TECHNIQUE :initarg :fitness-technique
  102.               :initform nil
  103.               :accessor fitness-technique)
  104.    (FITNESS-LIST :initarg :fitness-list :initform nil :accessor fitness-list)
  105.    (PARENT-SELECTION-TECHNIQUE
  106.      :initarg :parent-selection-technique
  107.      :initform nil
  108.      :accessor parent-selection-technique)
  109.    (REPRESENTATION-TECHNIQUE :initarg :representation-technique
  110.            :initform nil
  111.            :accessor representation-technique)
  112.    (INITIALIZATION-TECHNIQUE :initarg :initialization-technique
  113.                  :initform nil
  114.                  :accessor initialization-technique)
  115.    (REPRODUCTION-TECHNIQUE :initarg :reproduction-technique
  116.                  :initform nil
  117.                  :accessor reproduction-technique)
  118.    (DELETION-TECHNIQUE :initarg :deletion-technique
  119.                  :initform nil
  120.                  :accessor deletion-technique)
  121.    (PARAMETERIZATION-TECHNIQUES
  122.      :initarg :parameterization-techniques
  123.      :initform nil
  124.      :accessor parameterization-techniques)
  125.    (POPULATION-SIZE :initarg :population-size :initform nil :accessor population-size)
  126.    (DESIRED-TRIALS :initarg :desired-trials :initform nil :accessor desired-trials)
  127.    (CURRENT-INDEX :initarg :current-index
  128.              :initform 0 :accessor current-index)
  129.    (STOP-RUN? :initarg :stop-run? :initform nil :accessor stop-run?)
  130.    ))
  131.  
  132.  
  133.  
  134. ;************************************************************
  135.  
  136. ;    PARAMETERIZATION
  137.  
  138. ;;; Parameterization techniques modify parameters of a GA during a run.
  139.  
  140. (defclass PARAMETERIZATION-TECHNIQUE
  141.       ()
  142.      ()
  143.   )
  144.  
  145. ;;; Population parameterization techniques have pointers to their
  146. ;;; population module.
  147.  
  148. (defclass POPULATION-PARAMETERIZATION-TECHNIQUE
  149.       (parameterization-technique)
  150.      ((POPULATION-MODULE :initarg :population-module
  151.              :initform nil :accessor population-module))
  152.      )
  153.  
  154.  
  155. (defmethod INITIALIZE-FOR-RUN ((technique population-parameterization-technique))
  156.   t)
  157.  
  158.  
  159. ;;; Interpolate fitness decrement interpolates the value of the
  160. ;;; fitness decrement parameter in the fitness technique.
  161. ;;; The interpolation interval and interpolation specs contain
  162. ;;; default values.
  163.  
  164. (defclass INTERPOLATE-FITNESS-DECREMENT
  165.       (population-parameterization-technique)
  166.      ((INTERPOLATION-INTERVAL :accessor interpolation-interval
  167.                   :initarg :interpolation-interval
  168.                   :initform 50)
  169.       (INTERPOLATION-SPECS :accessor interpolation-specs
  170.                   :initarg :interpolation-specs
  171.                   :initform '(.2 1.2))
  172.       ))
  173.  
  174.  
  175.  
  176.  
  177. ;************************************************************
  178.  
  179. ;    FITNESS TECHNIQUES
  180.  
  181. ;;; A fitness technique generates the list of population member
  182. ;;; fitnesses.
  183.  
  184. (defclass FITNESS-TECHNIQUE
  185.       ()
  186.   ((POPULATION-MODULE :initarg :population-module
  187.                :initform nil :accessor population-module)
  188.    ))
  189.  
  190.  
  191. ;;; Fitness is evaluation uses raw evaluations as fitness.
  192.  
  193. (defclass FITNESS-IS-EVALUATION
  194.       (fitness-technique)
  195.   ())
  196.  
  197.  
  198. ;;; Linear normalization uses a linearly-decreasing list of
  199. ;;; fitnesses.  The starting value is the fitness of the first
  200. ;;; population member.  The decrement is the different between
  201. ;;; successive fitnesses.  The minimum value is the smallest
  202. ;;; value that may be placed on the list.  The values of these
  203. ;;; parameters given here are defaults.
  204.  
  205. (defclass LINEAR-NORMALIZATION
  206.       (fitness-technique)
  207.      ((STARTING-VALUE :initarg :starting-value
  208.                :initform 100 :accessor starting-value)
  209.       (DECREMENT :initarg :decrement
  210.                :initform  1 :accessor decrement)
  211.       (MINIMUM-VALUE :initarg :minimum-value
  212.                :initform 1 :accessor minimum-value)))
  213.  
  214.  
  215.  
  216.  
  217. ;************************************************************
  218.  
  219. ;     PARENT SELECTION TECHNIQUES
  220.  
  221. ;;; A parent selection technique is a technique for choosing a
  222. ;;; parent from a population for reproduction.
  223.  
  224. (defclass PARENT-SELECTION-TECHNIQUE
  225.       ()
  226.   ((POPULATION-MODULE :initarg :population-module
  227.                :initform nil :accessor population-module)
  228.    ))
  229.  
  230. ;;; Roulette wheel parent selection chooses parents randomly
  231. ;;; with chances biased by fitness.
  232.  
  233. (defclass ROULETTE-WHEEL-PARENT-SELECTION
  234.       (parent-selection-technique)
  235.      ((POPULATION-MODULE :initarg :population-module
  236.                :initform nil :accessor population-module)
  237.       ))
  238.  
  239.  
  240.  
  241. ;************************************************************
  242.  
  243. ;    REPRODUCTION TECHNIQUE
  244.  
  245. ;;; A reproduction technique is a technique for managing the
  246. ;;; population during reproduction.
  247.  
  248. (defclass REPRODUCTION-TECHNIQUE
  249.       ()
  250.   ((POPULATION-MODULE :initarg :population-module
  251.                :initform nil :accessor population-module)
  252.    ))
  253.  
  254.  
  255. ;;; Generational replacement replaces all members of a
  256. ;;; population during a run.
  257.  
  258. (defclass GENERATIONAL-REPLACEMENT
  259.       (reproduction-technique)
  260.   ())
  261.  
  262.  
  263. ;;; Generational replaclement with elitism carries the best
  264. ;;; member of a population into the next generation unmodified.
  265.  
  266. (defclass GENERATIONAL-REPLACEMENT-WITH-ELITISM
  267.       (generational-replacement)
  268.      ())
  269.  
  270.  
  271. ;;; Steady state reproduction involves replacing a few members
  272. ;;; of the population during each reproduction event.
  273.  
  274. (defclass STEADY-STATE
  275.       (reproduction-technique)
  276.   ())
  277.  
  278. ;;; Steady state without duplicates replaces a few members at a
  279. ;;; time, but allows no duplicate members in the population.  It
  280. ;;; stops when the number of duplicates it has found exceeds the
  281. ;;; maximum-duplicates parameter.
  282.  
  283. (defclass STEADY-STATE-WITHOUT-DUPLICATES
  284.   (steady-state)
  285.      ((DUPLICATE-TALLY :initarg :duplicate-tally
  286.           :initform 0 :accessor duplicate-tally)
  287.       (MAXIMUM-DUPLICATES :initarg :maximum-duplicates
  288.           :initform 0 :accessor maximum-duplicates)))
  289.  
  290.  
  291.  
  292. ;************************************************************
  293.  
  294. ;    DELETION TECHNIQUE
  295.  
  296. ;;; A deletion technique is a technique for deciding which
  297. ;;; population members to delete when new members have been
  298. ;;; generated.
  299.  
  300. (defclass DELETION-TECHNIQUE
  301.       ()
  302.   ((POPULATION-MODULE :initarg :population-module
  303.                :initform nil :accessor population-module)
  304.    ))
  305.  
  306. ;;; Delete all is a technique used with generational
  307. ;;; replacement.
  308.  
  309. (defclass DELETE-ALL
  310.       (deletion-technique)
  311.   ())
  312.  
  313. ;;; Delete last removes the worst member of the population to
  314. ;;; make room for a new member.
  315.  
  316. (defclass DELETE-LAST
  317.       (deletion-technique)
  318.      ())
  319.  
  320.  
  321.  
  322. ;************************************************************
  323.  
  324. ;    INITIALIZATION TECHNIQUE
  325.  
  326.  
  327. ;;; An initialization technique is a technique for generating
  328. ;;; the initial population of the genetic algorithm.  It may use
  329. ;;; seed chromosomes provided by another process.  When it is
  330. ;;; called it builds up a list of initial population members.
  331. ;;; When this list is as long as the population size, it
  332. ;;; installs it in the population module.
  333.  
  334. ;;; The initialization technique also maintains the population
  335. ;;; member class parameter.  The GA will create objects of this
  336. ;;; class when it makes new population members.
  337.  
  338. (defclass INITIALIZATION-TECHNIQUE
  339.       ()
  340.  
  341.   ((POPULATION-MODULE :initarg :population-module
  342.                :initform nil :accessor population-module)
  343.    (SEEDS :initarg :seeds :initform nil :accessor seeds)
  344.    (INITIAL-POPULATION :initarg :initial-population
  345.                :initform nil :accessor initial-population)
  346.    (POPULATION-MEMBER-CLASS :initarg :population-member-class
  347.                :initform 'population-member
  348.                :accessor population-member-class)
  349.    ))
  350.  
  351. ;;; Random binary initialization generates a population with
  352. ;;; random bit strings as chromosomes.
  353.  
  354. (defclass RANDOM-BINARY-INITIALIZATION
  355.       (initialization-technique)
  356.   ())
  357.  
  358. ;;; Random real number initialization generates an initial
  359. ;;; population with randomly generated real numbers in its
  360. ;;; chromosomes.
  361.  
  362. (defclass RANDOM-REAL-NUMBER-INITIALIZATION
  363.       (initialization-technique)
  364.   ())
  365.  
  366. ;;; Random permutation generates an initial population with
  367. ;;; permutations of a given list as its chromosomes.
  368.  
  369. (defclass RANDOM-PERMUTATION
  370.       (initialization-technique)
  371.   ((LIST-TO-PERMUTE :initarg :list-to-permute
  372.                :initform nil :accessor list-to-permute)))
  373.  
  374.  
  375. ;************************************************************
  376.  
  377. ;       REPRESENTATION TECHNIQUE
  378.  
  379. ;;; Representation techniques store information about the
  380. ;;; chromosomal representation.
  381.  
  382. (defclass REPRESENTATION-TECHNIQUE
  383.       ()
  384.      ((POPULATION-MODULE :initarg :population-module
  385.              :initform nil :accessor population-module)
  386.       ))
  387.  
  388. ;;; A binary representation is a list of bits.  The length of
  389. ;;; the list is stored here.
  390.  
  391. (defclass BINARY-REPRESENTATION
  392.       (representation-technique)
  393.      ((BIT-STRING-LENGTH :initarg :bit-string-length
  394.              :initform nil :accessor bit-string-length)
  395.       ))
  396.  
  397.  
  398. ;;; A real number representation is a list of real numbers.
  399. ;;; These are described by specs of the form
  400. ;;;   ((min max integer?) ... ).  The integer? parameter
  401. ;;;   determines whether the values should be maintained as
  402. ;;;   integers.
  403. (defclass  REAL-NUMBER-REPRESENTATION
  404.        (representation-technique)
  405.      ((REAL-NUMBER-SPECS :initarg :real-number-specs
  406.              :initform '((0 4194303 t))
  407.              :accessor real-number-specs)
  408.       (CHROMOSOME-LENGTH :initarg :chromosome-length
  409.              :initform 2
  410.              :accessor chromosome-length)))
  411.  
  412. ;;; A permuted list is a permutation of a basic list.
  413.  
  414. (defclass PERMUTED-LIST
  415.       (representation-technique)
  416.   ())
  417.  
  418.  
  419. ;************************************************************
  420.  
  421. ;     POPULATION MEMBER
  422.  
  423.  
  424.  
  425. ;;; POPULATION-MEMBER is the basic member of the genetic
  426. ;;; algorithm population.  A population member is one member of a
  427. ;;; linked list. It has an evaluation, an chromosome that is the
  428. ;;; thing the operators and evaluator
  429. ;;; work on, a predecessor in the population, a successor in the
  430. ;;; population, and an index that matches the
  431. ;;; current-index in the population module when
  432. ;;; the member is created.
  433.  
  434. ;;; The population is maintained in sorted order by evaluations.
  435.  
  436. (defclass POPULATION-MEMBER
  437.       (doubly-linked-list-element)
  438.   ((EVALUATION :initarg :evaluation :initform nil :accessor evaluation)
  439.    (CHROMOSOME :initarg :chromosome :initform nil :accessor chromosome)
  440.    (INDEX :initarg :index :initform nil :accessor index)
  441.    (POPULATION-MODULE :initarg :population-module :accessor POPULATION-MODULE)
  442.    ))
  443.  
  444.  
  445.  
  446.  
  447. ;************************************************************
  448.  
  449. ;    STATISTICS COLLECTION
  450.  
  451.  
  452. ;;; The performance statistics collection object is a component
  453. ;;; of the population modules used in the tutorial.  The object
  454. ;;; periodically stores the evaluation of the best population
  455. ;;; member on its performance statistics slot.  The storage
  456. ;;; interval is a parameter of the object.
  457.  
  458. (defclass PERFORMANCE-STATISTICS-COLLECTION
  459.       ()
  460.      ((PERFORMANCE-STATISTICS :initarg :performance-statistics
  461.                   :initform nil :accessor performance-statistics)
  462.       (PERFORMANCE-STATISTICS-INTERVAL :initarg :performance-statistics-interval
  463.                   :initform 100 :accessor performance-statistics-interval))
  464.   )
  465.  
  466.  
  467.  
  468.  
  469. ;************************************************************
  470.  
  471. ;    PERIODIC STATE DISPLAY
  472.  
  473. ;;; The periodic state display object is a component of the
  474. ;;; population modules used in the tutorial.  When the display
  475. ;;; flag is on, this object displays the top n members of the
  476. ;;; population.  The number to display and frequence of display
  477. ;;; are parameters of the object.
  478.  
  479. (defclass PERIODIC-STATE-DISPLAY
  480.       ()
  481.      ((DISPLAY-PERIOD :accessor display-period :initarg :display-period
  482.         :initform 200)
  483.       (DISPLAY-FLAG :accessor display-flag :initarg :display-flag
  484.         :initform t)
  485.       (NUMBER-TO-DISPLAY :accessor number-to-display :initarg :number-to-display
  486.         :initform 5))
  487.   (:documentation 
  488.     "The PERIODIC-STATE-DISPLAY is used to show the state of the GA at regular
  489. intervals."))
  490.  
  491.  
  492.  
  493. ;************************************************************
  494. ;************************************************************
  495.  
  496. ;     BASIC REPRODUCTION MODULE
  497.  
  498. ;************************************************************
  499. ;************************************************************
  500.  
  501.  
  502. ;;; The reproduction module drives the reproduction process.  It
  503. ;;; has pointers to its GA, a list of operators, and a list of
  504. ;;; operator weights.  It includes an operator selection
  505. ;;; technique and a list of parameterization techniques.
  506.  
  507. ;;; Default operator weights are for a system with a single
  508. ;;; operator.
  509.  
  510. (defclass BASIC-REPRODUCTION-MODULE
  511.       ()
  512.   ((GA :initarg :ga :initform nil :accessor ga)
  513.    (OPERATOR-SELECTION-TECHNIQUE :initarg :operator-selection-technique
  514.                  :initform nil
  515.                  :accessor operator-selection-technique)
  516.    (OPERATOR-LIST :initarg :operator-list
  517.           :initform nil
  518.           :accessor operator-list)
  519.    (PARAMETERIZATION-TECHNIQUES
  520.      :initarg :parameterization-techniques
  521.      :initform nil
  522.      :accessor parameterization-techniques)
  523.    (OPERATOR-WEIGHTS :initarg :operator-weights :initform '(100) :accessor operator-weights)
  524.    ))
  525.  
  526.  
  527.  
  528. ;************************************************************
  529.  
  530. ;    OPERATOR SELECTION TECHNIQUE
  531.  
  532.  
  533. ;;; An operator selection technique selects an operator for a
  534. ;;; reproduction event.
  535.  
  536. (defclass OPERATOR-SELECTION-TECHNIQUE
  537.       ()
  538.      ((REPRODUCTION-MODULE :initarg :reproduction-module
  539.                :initform nil :accessor reproduction-module)
  540.       ))
  541.  
  542.  
  543. ;;; Use first operator selects the first operator in the
  544. ;;; operator list.  This is used for efficiency in the
  545. ;;; traditional genetic algorithm, which has only one operator.
  546.  
  547. (defclass USE-FIRST-OPERATOR
  548.       (operator-selection-technique)
  549.      ())
  550.  
  551. ;;; Roulette wheel operator selection chooses an operator from
  552. ;;; the operator list, with selection chances biased by each
  553. ;;; operator's corresponding weight.
  554.  
  555. (defclass ROULETTE-WHEEL-OPERATOR-SELECTION
  556.       (operator-selection-technique)
  557.      ())
  558.  
  559.  
  560.  
  561. ;************************************************************
  562.  
  563. ;    REPRODUCTION PARAMETERIZATION TECHNIQUES
  564.  
  565.  
  566. ;;; A reproduction parameterization technique is a technique for
  567. ;;; altering the parameters of the reproduction module during a
  568. ;;; run.
  569.  
  570. (defclass REPRODUCTION-PARAMETERIZATION-TECHNIQUE
  571.       (parameterization-technique)
  572.   ((REPRODUCTION-MODULE :initarg :reproduction-module
  573.                :initform nil :accessor reproduction-module)
  574.    ))
  575.  
  576. ;;; Interpolate operator weights modifies the operator weight
  577. ;;; list by interpolating between initial and final weights as
  578. ;;; the run proceeds.  The default interpolation specs are for a
  579. ;;; two-operator operator list.  
  580.  
  581. (defclass INTERPOLATE-OPERATOR-WEIGHTS
  582.       (reproduction-parameterization-technique)
  583.      ((INTERPOLATION-INTERVAL :accessor interpolation-interval
  584.                   :initarg :interpolation-interval
  585.                   :initform 50)
  586.       (INTERPOLATION-SPECS :accessor interpolation-specs
  587.                   :initarg :interpolation-specs
  588.                   :initform '((60 40) (30 70)))))
  589.  
  590.  
  591.  
  592.  
  593. ;************************************************************
  594.  
  595. ;    OPERATORS
  596.  
  597. ;;; A GA operator is a technique for generating new population
  598. ;;; members.  
  599.  
  600. (defclass GA-OPERATOR
  601.       ()
  602.   ((REPRODUCTION-MODULE :initarg :reproduction-module
  603.             :initform nil :accessor reproduction-module)
  604.    ))
  605.  
  606. ;;; One point crossover and mutate takes two parents as input
  607. ;;; and returns two children.  The children are the result of
  608. ;;; applying one point crossover to the parents if the crossover
  609. ;;; rate test is passed.  Each bit of the children is replaced
  610. ;;; with a randomly selected bit if the bit mutation rate test
  611. ;;; is passed for that bit.
  612.  
  613. (defclass ONE-POINT-CROSSOVER-AND-MUTATE
  614.       (ga-operator)
  615.      ((BIT-MUTATION-RATE :initarg :bit-mutation-rate
  616.               :initform .008
  617.               :accessor bit-mutation-rate)
  618.       (CROSSOVER-RATE :initarg :crossover-rate
  619.               :initform .65
  620.               :accessor crossover-rate)
  621.       ))
  622.  
  623. ;;; One point crossover returns two children that are the result
  624. ;;; of applying one point crossover to two parents.
  625.  
  626. (defclass ONE-POINT-CROSSOVER
  627.       (ga-operator)
  628.      ())
  629.  
  630.  
  631. ;;; One point crossover returns two children that are the result
  632. ;;; of applying two point crossover to two parents.
  633.  
  634. (defclass TWO-POINT-CROSSOVER
  635.     (ga-operator)
  636.   ())
  637.  
  638.  
  639. ;;; Binary mutation returns one child that is the result of
  640. ;;; applying binary mutation at the bit mutation rate to a
  641. ;;; single parent.
  642.  
  643. (defclass BINARY-MUTATION
  644.       (ga-operator)
  645.      ((BIT-MUTATION-RATE :initarg :bit-mutation-rate
  646.               :initform .04
  647.               :accessor bit-mutation-rate)))
  648.  
  649.  
  650. ;;; Uniform list crossover takes two parents and returns two
  651. ;;; children that are the result of applying uniform crossover
  652. ;;; to the parents.
  653.  
  654. (defclass UNIFORM-LIST-CROSSOVER
  655.       (ga-operator)
  656.      ())
  657.  
  658. ;;; Random bit string generation takes no parents and returns a
  659. ;;; randomly generated bit string.  (This operator is used for
  660. ;;; comparing comparing the performance of random generation
  661. ;;; optimizers with more intelligent ones.)
  662.  
  663. (defclass RANDOM-BIT-STRING-GENERATION
  664.       (ga-operator)
  665.      (
  666.       ))
  667.  
  668. ;;; Real number mutation replaces real numbers on a chromosome
  669. ;;; with randomly selected ones if a probability test is passed.
  670. ;;; The default mutation rate here is abnormally high; it is set
  671. ;;; for the example in the tutorial, with a chromosome
  672. ;;; containing only two values.  The mutation specs describe the
  673. ;;; minimum and maximum values for each field, and whether
  674. ;;; values should be integral.
  675.  
  676. (defclass REAL-NUMBER-MUTATION
  677.       (ga-operator)
  678.      ((MUTATION-RATE :initarg :mutation-rate
  679.               :initform .5
  680.               :accessor mutation-rate)
  681.       (MUTATION-SPECS :initarg :mutation-specs
  682.               :initform '((0 4194303 t))
  683.               :accessor mutation-specs)))
  684.  
  685.  
  686. ;;; Real number creep creeps the value of each field on a
  687. ;;; real-number chromosome if a probability test is passed.  The
  688. ;;; rate of creep is a parameter.  Specs giving the maximum
  689. ;;; amount of the creep and whether to force the result to be an
  690. ;;; integer are another parameter of the operator.
  691.  
  692. (defclass REAL-NUMBER-CREEP
  693.       (ga-operator)
  694.      ((CREEP-RATE :initarg :creep-rate
  695.               :initform .7
  696.               :accessor creep-rate)
  697.       (CREEP-SPECS :initarg :creep-specs
  698.               :initform '((12000 t))
  699.               :accessor creep-specs)))
  700.  
  701.  
  702. ;;; Average crossover takes two real-number parents as input and
  703. ;;; returns a single child that is the result of averaging the
  704. ;;; fields in the parents.
  705.  
  706. (defclass AVERAGE-CROSSOVER
  707.       (ga-operator)
  708.      (
  709.       ))
  710.  
  711.  
  712. ;;; AVERAGE-REAL-CROSSOVER is like AVERAGE-CROSSOVER except that
  713. ;;; it does not round off the result of the average.
  714. (defclass AVERAGE-REAL-CROSSOVER (ga-operator) ())
  715.  
  716.  
  717. ;;; Uniform order based crossover takes two parents as input and
  718. ;;; returns two children that are the result of applying
  719. ;;; order-based crossover to the parents.
  720.  
  721. (defclass UNIFORM-ORDER-BASED-CROSSOVER
  722.       (ga-operator)
  723.      (
  724.       ))
  725.  
  726.  
  727. ;;; Scramble sublist mutation takes one parent as input.
  728. ;;; It generates a single child like the parent except that
  729. ;;; a randomly-selected sublist of the parent is permuted.
  730.  
  731. (defclass SCRAMBLE-SUBLIST-MUTATION
  732.       (ga-operator)
  733.      (
  734.       ))
  735.  
  736. ;;; Random order generation generates a random permutation of a
  737. ;;; base list.  (This operator is used to compare populations
  738. ;;; of randomly generated permutations with populations
  739. ;;; of intelligently generated ones.)
  740.  
  741. (defclass RANDOM-ORDER-GENERATION
  742.       (ga-operator)
  743.      (
  744.       ))
  745.  
  746. ;************************************************************
  747.  
  748. ;    OPERATOR ADAPTATION DEFCLASSES
  749.  
  750.  
  751. ;    POPULATION MEMBER CLASSES
  752.  
  753. ;;; A lineage population member maintains pointers to its
  754. ;;; parents and children.
  755.  
  756. (defclass LINEAGE-POPULATION-MEMBER
  757.       (population-member)
  758.      ((CHILDREN :initarg :children
  759.              :initform nil :accessor children)
  760.       (PARENTS :initarg :parents
  761.              :initform nil :accessor parents))
  762.   )
  763.  
  764.  
  765. ;;; An adaptation population member maintains the amount of
  766. ;;; delta it has earned, and the amount it has inherited.
  767.  
  768. (defclass ADAPTATION-POPULATION-MEMBER
  769.       (lineage-population-member)
  770.      ((LOCAL-DELTA :initarg :local-delta
  771.              :initform 0 :accessor local-delta)
  772.       (INHERITED-DELTA :initarg :inherited-delta
  773.              :initform 0 :accessor inherited-delta))
  774.   )
  775.  
  776.  
  777. ;  ADAPTATION POPULATION MODULE
  778.  
  779.  
  780. ;;; A lineage list is a component of a lineage tracking
  781. ;;; mechanism.
  782.  
  783. (defclass LINEAGE-LIST
  784.       ()
  785.      ((lineage :initarg :lineage :initform nil :accessor lineage)))
  786.  
  787.  
  788. ;;; A lineage tracker maintains a lineage list, noting who
  789. ;;; created who.
  790.  
  791. (defclass LINEAGE-TRACKER
  792.       (basic-population-module)
  793.      ((LINEAGE-LIST :initarg :lineage-list
  794.              :initform (make-instance 'lineage-list)
  795.              :accessor lineage-list)))
  796.  
  797.  
  798. ;;; An adapative operator module is an object that tracks the
  799. ;;; performance of the operators in the reproduction module, and
  800. ;;; modifies their weights periodically in accord with their
  801. ;;; recently observed performance.  This object is a component
  802. ;;; of population modules.  It maintains a number of parameters
  803. ;;; described in detail in the methods file.
  804.  
  805. (defclass ADAPTIVE-OPERATOR-MODULE
  806.       (lineage-tracker)
  807.   ((ADAPTATION-INTERVAL :initarg :adaptation-interval
  808.              :initform 50 :accessor adaptation-interval)
  809.    (ADAPTATION-WINDOW :initarg :adaptation-window
  810.              :initform 100 :accessor adaptation-window)
  811.    (NEXT-ADAPTATION :initarg :next-adaptation
  812.              :initform nil :accessor next-adaptation)
  813.    (INITIAL-OPERATOR-WEIGHTS :initarg :initial-operator-weights
  814.              :initform nil :accessor initial-operator-weights)
  815.    (MINIMUM-OPERATOR-WEIGHT :initarg :minimum-operator-weight
  816.              :initform 10 :accessor minimum-operator-weight)
  817.    (ADAPTIVE-DELTA-AMOUNT :initarg :adaptive-delta-amount
  818.               :initform 10 :accessor adaptive-delta-amount)
  819.    (INHERITED-DELTA-SCALAR :initarg :inherited-delta-scalar
  820.              :initform .9 :accessor inherited-delta-scalar)
  821.    (INHERITED-DELTA-GENERATIONS :initarg :inherited-delta-generations
  822.              :initform 5 :accessor inherited-delta-generations)
  823.    ))
  824.  
  825.  
  826. ;;; The adaptive reproduction module sets pointers from parents to children
  827. ;;; and vice verse.
  828.  
  829. (defclass ADAPTIVE-REPRODUCTION-MODULE
  830.       (basic-reproduction-module) ())
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837. ;************************************************************
  838.  
  839. ;    NAME-GA
  840.  
  841. ;;; A function for debugging use.  It is not called by the system.
  842. ;;; Do not use NAME-GA if you use variables named g, e, p, or r.
  843. ;;; It binds those variables to *ga* and its modules for quick keyboard
  844. ;;; reference.
  845.  
  846.  
  847. (defun NAME-GA (&optional (ga *ga*))
  848.   (declare (special g e p r))
  849.   (if (typep ga 'basic-genetic-algorithm)
  850.       (setf g ga
  851.         e (evaluation-module ga)
  852.         p (population-module ga)
  853.         r (reproduction-module ga))
  854.       (format *standard-output*
  855.           "~%~%NAME-GA NEEDS A GENETIC ALGORITHM AS ARGUMENT, ~%OR *GA* MUST BE BOUND TO A GENETIC ALGORITHM.~%~%")))
  856.